unit uSBDUnit_SampleTests1;
interface
uses uSBDUnit_Executive, uSBDUnit_View, uSBDUnit_Controller, uSBDUnit_Model;

type
TSample1Executive = class( TUnitTestExecutive)
  private
    constructor Create;

  public
    class function Instance: TUnitTestExecutive;       override;
    function  MakeViews: TArray<IUnitTestView>;        override;
    function  MakeController: IUnitTestController;     override;
    function  ControllingView: IUnitTestView;          override;
    procedure RegisterAllTestSuites;                   override;
    destructor Destroy; override;
  end;

implementation
















uses uSBDUnit_controller1, umfmGUIRunner, Classes, Dialogs, Controls, SysUtils;


var
  Inst: TSample1Executive = nil;


type
[TestSuite('ThisIsATestGroup.ATestSuite')]
TFirstSampleTestSuite = class( TTestSuite)
  public
    procedure Setup;             override;
    procedure Teardown;          override;

    [TestCase]
    procedure FirstTestCase;
  end;

[TestSuite('ThisIsATestGroup.')]
TSecondSampleTestSuite = class( TTestSuite)
  public
    procedure Setup;             override;
    procedure Teardown;          override;

    [TestCase, CheckMemory]
    procedure SecondTestCase;
  end;

TThirdSampleTestSuite = class( TTestSuite)
  public
    procedure Setup;             override;
    procedure Teardown;          override;

    [TestCase,Repeated(2)]
    procedure ThirdTestCase;
  end;


TFourthSampleTestSuite = class( TInterfacedPersistent, ITestSuite)
  strict private
    FHarness: ITestHarness;

  private
    procedure SetHarness( const Harness1: ITestHarness);
    procedure Setup;
    procedure Teardown;

  public
    [TestCase] procedure FourthTestCase;
    [SuiteConstructor] constructor Create;
  end;

function TSample1Executive.ControllingView: IUnitTestView;
begin
result := mfmGUIRunner
end;

constructor TSample1Executive.Create;
begin
inherited Create;
Inst := self;
end;

destructor TSample1Executive.Destroy;
begin
if Inst = self then
  Inst := nil;
inherited
end;

class function TSample1Executive.Instance: TUnitTestExecutive;
begin
if not assigned( Inst) then
  TSample1Executive.Create;
result := Inst
end;

function TSample1Executive.MakeController: IUnitTestController;
begin
result := TSample1Controller.Create
end;

function TSample1Executive.MakeViews: TArray<IUnitTestView>;
begin
SetLength( result, 1);
result[0] := mfmGUIRunner
end;

procedure TSample1Executive.RegisterAllTestSuites;
begin
TestSuites( [TFirstSampleTestSuite, TSecondSampleTestSuite,
             TThirdSampleTestSuite, TFourthSampleTestSuite]);
end;



procedure DemoMsg( const Line: string);
begin
ShowMessage( Line)
end;

function DemoAsk( const Line: string): boolean;
begin
result := MessageDlg( Line, mtConfirmation, [mbYes, mbNo], 0) = mrYes
end;


{ TSeansTestSuite }

procedure TFirstSampleTestSuite.Setup;
begin
DemoMsg( 'First sample Test Suite setup')
end;

procedure TFirstSampleTestSuite.Teardown;
begin
DemoMsg( 'First sample Test Suite teardown')
end;

procedure TFirstSampleTestSuite.FirstTestCase;
begin
Check( not DemoAsk('1st test case'#13#10 + 'Simulate a test case failure?'), 'The test failed.');
end;

{ TSeansTestSuite2 }

procedure TSecondSampleTestSuite.Setup;
begin
if DemoAsk ('Second sample Test Suite setup'#13#10 + 'Simulate user code exception in Setup?') then
  raise Exception.Create('Some user exception with a TestSuite Setup.');
end;

procedure TSecondSampleTestSuite.Teardown;
begin
if DemoAsk ('Second sample Test Suite teardown'#13#10 + 'Simulate user code exception in Teardown?') then
  raise Exception.Create('Some user exception with a TestSuite Teardown.');
end;

procedure TSecondSampleTestSuite.SecondTestCase;
begin
Check( not DemoAsk('2nd test case'#13#10 + 'Simulate a test case failure?'), 'The test failed.');
end;

{ TSeansTestSuite3 }

procedure TThirdSampleTestSuite.Setup;
begin
DemoMsg( 'Third sample Test Suite setup')
end;

procedure TThirdSampleTestSuite.Teardown;
begin
DemoMsg( 'Third sample Test Suite teardown')
end;

procedure TThirdSampleTestSuite.ThirdTestCase;
begin
Check( not DemoAsk('3rd test case'#13#10 + 'Simulate a test case failure?'), 'The test failed.');
end;

{ TSeansTestSuite4 }

constructor TFourthSampleTestSuite.Create;
begin
end;

procedure TFourthSampleTestSuite.SetHarness( const Harness1: ITestHarness);
begin
FHarness := Harness1
end;

procedure TFourthSampleTestSuite.Setup;
begin
DemoMsg( 'Fourth sample Test Suite setup')

end;

procedure TFourthSampleTestSuite.Teardown;
begin
DemoMsg( 'Fourth sample Test Suite teardown')
end;

procedure TFourthSampleTestSuite.FourthTestCase;
begin
FHarness.Check( not DemoAsk('4th test case'#13#10 + 'Simulate a test case failure?'), 'The test failed.');
end;

end.
